MacFormat 1995 May/macformat-024.iso/Shareware City/Developers/TransSkel Pascal 2.5/TransSkel/Skel ƒ/Skel.p

Text File | 1994-12-12 | 5.0 KB | 214 lines | [TEXT/PJMM]

{    TransSkel demonstration:  Traditional Skel}

{    This program mimics the original Skel application:  one sizable,}
{    dragable, non-closable dark gray window, an "About" alert and two}
{    dialogs.  Desk accessories supported.}

{    The project should include this file, TransSkel.p (or a library}
{    built from TransSkel.p), Runtime.lib and Interface.lib.}

{    27 June 1986        Paul DuBois}
{    1 January 1987    Ωhm Software - port to LS Pascal    }
{    30 December 1987 Ωhm Software - changes for version 2.00 }

program Skel;

    uses
{$IFC UNDEFINED THINK_PASCAL}
        Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf,
{$ENDC}
        TransSkel;

    const
{    Resource numbers}

        fileMenuRes = 2;        { File menu }
        AboutAlrt = 1000;    { About box }
        theWindRes = 260;        { window }
        reportDlog = 257;        { message dialog box }
        aboutStr = 1;        { message strings }
        rattleStr = 2;
        frightStr = 3;

{ file menu item numbers }

        rattle = 1;
        frighten = 2;
        quit = 4;

    type
        EventPtr = ^EventRecord;

    var
        theWind: WindowPtr;

{    Menu handles.  There isn't any apple menu here, since TransSkel will}
{    be told to handle it itself.}

        fileMenu: MenuHandle;

{      Dummy Boolean.  This may be used for Memory Management, if desired }

        dummy: Boolean;

{ -------------------------------------------------------------------- }
{                        Menu handling procedures                        }
{ -------------------------------------------------------------------- }

{    Read a string resource and put into the Alert/Dialog paramtext}
{    values}

    procedure SetParamText (strNum: integer);

        var
            h: StringHandle;

    begin
        h := GetString(strNum);
        HLock(Handle(h));
        ParamText(h^^, '', '', '');
        HUnlock(Handle(h));
    end;

{    Handle selection of "About Skel…" item from Apple menu}

    procedure DoAbout;

        var
            h: StringHandle;
            ignore: integer;

    begin
        SetParamText(aboutStr);
        ignore := Alert(aboutAlrt, nil);
    end;

{    Put up a dialog box with a message and an OK button.  The message}
{    is stored in the 'STR ' resource whose number is passed as strNum.}

    procedure report (strNum: integer);

        var
            theDialog: DialogPtr;
            itemHit: integer;

    begin
        SetParamText(strNum);
        theDialog := GetNewDialog(Integer(reportDlog), Ptr(nil), WindowPtr(-1));
        ModalDialog(nil, itemhit);
        DisposDialog(theDialog);
    end;

{    Process selection from File menu.}

{    Rattle, Frighten    A dialog box with message}
{    Quit    Request a halt by calling SkelHalt().  This makes SkelMain}
{            return.}

    procedure DoFileMenu (item: integer);

    begin
        case item of
            rattle:
                Report(rattleStr);
            frighten:
                Report(frightStr);
            quit:
                SkelWhoa;
            otherwise
                ;
        end;
    end;


{    Initialize menus.  Tell TransSkel to process the Apple menu}
{    automatically, and associate the proper procedures with the}
{    File and Edit menus.}

    procedure SetUpMenus;

    begin
        SkelApple('About Skel…', @DoAbout);
        fileMenu := GetMenu(fileMenuRes);
        dummy := SkelMenu(fileMenu, @DoFileMenu, nil, true);
    end;

{ -------------------------------------------------------------------- }
{                    Window handling procedures                            }
{ -------------------------------------------------------------------- }

    procedure WindActivate (active: Boolean);

    begin
        DrawGrowIcon(theWind);    { make grow box reflect new window state }
    end;

{    On update event, can ignore the resizing information, since the whole}
{    window is always redrawn in terms of the current size, anyway.}
{    Content area is dark gray except scroll bar areas, which are white.}
{    Draw grow box as well.}

    procedure WindUpdate (resized: Boolean);

        var
            r: Rect;

    begin
        r := theWind^.portRect;        { paint window dark gray }
        r.bottom := r.bottom - 15;            { don't bother painting the }
        r.right := r.right - 15;            { scroll bar areas }
{$IFC UNDEFINED THINK_PASCAL}
        FillRect(r, qd.dkGray);
{$ELSEC}
        FillRect(r, dkGray);
{$ENDC}
        r := theWind^.portRect;    { paint scroll bar areas white }
        r.left := r.right - 15;
{$IFC UNDEFINED THINK_PASCAL}
        FillRect(r, qd.white);
{$ELSEC}
        FillRect(r, white);
{$ENDC}
        r := theWind^.portRect;
        r.top := r.bottom - 15;
{$IFC UNDEFINED THINK_PASCAL}
        FillRect(r, qd.white);
{$ELSEC}
        FillRect(r, white);
{$ENDC}
        DrawGrowIcon(theWind);
    end;

    procedure WindHalt;

    begin
        CloseWindow(theWind);
    end;

{    Read window from resource file and install handler for it.  Mouse}
{    and key clicks are ignored.  There is no close proc since the window}
{    doesn't have a close box.  There is no idle proc since nothing is}
{    done while the window is in front (all the things that are done are}
{    handled by TransSkel).}

    procedure WindInit;

    begin
        theWind := GetNewWindow(theWindRes, nil, WindowPtr(-1));
        SetPort(theWind);
        dummy := SkelWindow(theWind, nil, nil, @WindUpdate, @WindActivate, nil, @WindHalt, nil, false);
    end;

{ -------------------------------------------------------------------- }
{                                    Main                                }
{ -------------------------------------------------------------------- }


begin
    SkelInit(6, nil);                { initialize }
    SetUpMenus;                { install menu handlers }
    WindInit;                    { install window handler }
    SkelMain;                { loop 'til Quit selected }
    SkelClobber;                { clean up }
end.